home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / boi.exe / IOLIB.PAS < prev    next >
Pascal/Delphi Source File  |  1990-12-12  |  16KB  |  548 lines

  1. {$D-}
  2. {$S-}
  3. {$V-}
  4.  
  5. Unit IOLib;
  6. { Part of BBS Onliner Interface }
  7. { Copyright (C) 1990 Andrew J. Mead
  8.   All Rights Reserved. }
  9.  
  10. { BBS Onliner Interface contains
  11.   Async     - low-level serial port communications interrupt handler
  12.   BOIDecl   - BOI standard declarations
  13.   IOLib     - standard console and port communications routines
  14.   IOSupp    - extended character code processing for IOLib-ReadPortKey
  15.   GetCmBBS  - command line parser
  16.   Support   - common library functions and procedures }
  17.  
  18. { Original version 7/1/90
  19.   Original release version 1.0 beta 9/5/90
  20.   Version  1.01  9/19/90 /Q quiet local mode switch added
  21.   Version  1.01b 9/20/90 realname usage added, /A Remote Access defined
  22.   Version  1.02  9/22/90 RA access removed, /Q switch fixed
  23.   Version  1.03  9/23/90 /A play it Again switch added
  24.   Version  1.10  9/24/90 /2, /F, /M, /H, /5, /6 switches added
  25.   Version  1.11  9/29/90 beta version of /B locked baud rate
  26.   Version  1.12 10/ 1/90 /P switch added
  27.   Version  1.13 10/10/90 /N switch added
  28.   Version  1.14 10/22/90 /B switch fixed, carrier dectect routines added
  29.   Version  1.15 10/25/90 internal reorginizations, /K added
  30.   Version  1.16 11/ 9/90 /K fixed, F-9 abort added.
  31.   Version  1.17 12/ 1/90 internal reorginizations.
  32.   Version  1.17b12/ 5/90 /P fixed, /O implemented
  33.   Version  1.18 12/ 9/90 /O,/P verified /1,/3 implemented.
  34.   Version  1.20 12/10/90 Initial Public Release.
  35.  
  36. }
  37.  
  38. INTERFACE
  39.  
  40. Uses
  41.   Dos;
  42.  
  43. { Standard Functions }
  44.  
  45.   Function MIN(a,b : word) : word;
  46.   Function MAX(a,b : word) : word;
  47.  
  48.   {* Internal timing *}
  49.   Procedure TIMERSET(var basetime : longint); { initialize timer value }
  50.   Function GETTIMER(  {boolean}             { true if val seconds has passed }
  51.       var basetime : longint;               { starting time }
  52.       val          : word)                  { number of seconds }
  53.       : boolean;
  54.  
  55.   {* file validation *}
  56.   Function EXIST(thisfile : pathstr) : boolean;
  57.   Function VALID(thisfile : pathstr) : boolean;
  58.  
  59. { Memory Function }
  60.   Function KEYPRESSED : Boolean;   { RAM - check keyboard buffer }
  61.  
  62. { BIOS Functions }
  63.   Function READKEY : char;         { BIOS - get key from keyboard buffer }
  64.   Function WHEREX : byte;          { BIOS - get current cursor x position }
  65.   Function WHEREY : byte;          { BIOS - get current cursor y position }
  66.   Procedure DELAY(ms : Word);      { BIOS - CPU delay, 993 = 1 second }
  67.  
  68. { ANSI Functions }
  69.   { Input/Output string procedures }
  70.   Procedure SENDSTRING(            { send string to output }
  71.       outstr : string;             { string to output }
  72.       docr : boolean);             { send CR/LF indicator }
  73.   Function INTSTR( { returns a string of the input integer }
  74.       val : longint;               { value to convert }
  75.       isize : byte) : string;      { padded size of the string }
  76.   Function REALSTR({ returns a string of the input real value }
  77.       rval  : real;                { value to convert }
  78.       rsize,                       { padded size of the string }
  79.       rdec  : byte) : string;      { number of decimal places in string }
  80.   Function PADSTR( { returns a right justified string }
  81.       pstr : string;               { string to right justify }
  82.       psize : byte) : string;      { size of string }
  83.   Procedure GETSTRING(var gstr : string);  { all input chars upto next CR }
  84.  
  85.   { Housecleaning procedures }
  86.   Procedure SETPORT;               { Initialize Async Communications }
  87.   Procedure ENDPORT;               { Terminate Async Communications }
  88.  
  89.   { Positional/Attribute Functions }
  90.   Procedure GOTOPORTXY(x,y : byte);  { Position cursor at given coordinates }
  91.   Procedure PORTCOLOR(  { if docolor then set acolor else set bcolor }
  92.       acolor,                      { color text attributes }
  93.       bcolor : byte);              { monochrome text attributes }
  94.   Procedure TEXTPORTCOLOR(color : byte);  { set text attributes }
  95.   Procedure PORTBACKGROUND(color: byte);  { set background attributes }
  96.   Procedure CLRPORTSCR;            { clear current window }
  97.   Procedure CLRPORTEOL;            { clear current line to End Of Line }
  98.   Procedure PORTWINDOW(x1,y1,x2,y2 : byte);  { Set display Window }
  99.   Procedure PORTCOLUMNONE;         { put cursor in column one on current line }
  100.  
  101.   { Basic Input function }
  102.   Function READPORTKEY : char;     { get input character }
  103.   Function PORTKEYPRESSED : boolean; { character ready for processing }
  104.  
  105.   { reset function }
  106.   Procedure CLEARBUFFERS;          { clear keyboard and port input buffers }
  107.  
  108.   { Advanced positional group }
  109.   Procedure SETPORTXY;             { save current cursor position }
  110.   Procedure RESETPORTXY;           { restore saved cursor position }
  111.  
  112.   { Timeout procedure }
  113.   Function LEFTTIME : integer;     { remaing player time in minutes }
  114.   Procedure DOTIMEOUT(ringbell : boolean); { exit program due to inactivity }
  115.  
  116. IMPLEMENTATION
  117.  
  118. Uses
  119.   boidecl,
  120.   iosupp,
  121.   Async;
  122.  
  123. Const
  124.   null  = #0;
  125.   bell  = #7;
  126.   esc   = #27;
  127.   f10   = #$44; {scan code}
  128.   basex : byte = 1;
  129.   basey : byte = 1;
  130.   tempx : byte = 1;
  131.   tempy : byte = 1;
  132.   endx  : byte = 24;
  133.   endy  : byte = 80;
  134.  
  135. Var
  136.   regs        : registers;
  137.   textattr    : word;
  138.   workstr     : string;
  139.  
  140. Function MIN(a,b : word) : word;
  141.   begin {* fMin *}
  142.     if a < b then Min := a else Min := b
  143.   end;  {* fMin *}
  144.  
  145. Function MAX(a,b : word) : word;
  146.   begin {* fMax *}
  147.     if a > b then Max := a else Max := b
  148.   end;  {* fMax *}
  149.  
  150. Procedure TIMERSET(var basetime : longint);
  151.   begin {* TimerSet *}
  152.     move(memw[$40:$6C],basetime,4)
  153.   end;  {* TimerSet *}
  154.  
  155. Function GETTIMER(var basetime : longint; val : word) : boolean;
  156.   var thistime : longint;
  157.  
  158.   begin {* GetTimer *}
  159.     move(memw[$40:$6C],thistime,4);
  160.     GetTimer := trunc((thistime - basetime) / 18.2) > val;
  161.   end;  {* GetTimer *}
  162.  
  163. Function EXIST(thisfile : pathstr) : boolean;
  164.   var
  165.     afile : file;
  166.     iocode : word;
  167.  
  168.   begin {* fExist *}
  169.     assign(afile,thisfile);
  170.     {$I-}
  171.     reset(afile);
  172.     {$I+}
  173.     iocode := ioresult;
  174.     Exist := (iocode = 0);
  175.     if iocode = 0 then close(afile);
  176.   end;  {* fExist *}
  177.  
  178. Function VALID(thisfile : pathstr) : boolean;
  179.   Var
  180.     afile : file;
  181.     check : boolean;
  182.     iocode : word;
  183.  
  184.   begin {* fValid *}
  185.     if not Exist(thisfile) then
  186.       begin
  187.         assign(afile,thisfile);
  188.         {$I-}
  189.         rewrite(afile);
  190.         close(afile);
  191.         erase(afile);
  192.         {$I+}
  193.         iocode := ioresult;
  194.         Valid := (iocode = 0)
  195.       end
  196.     else Valid := true
  197.   end;  {* fValid *}
  198.  
  199.  
  200. Procedure DELAY(MS: Word);
  201.   begin {* Delay *}
  202.     with regs do
  203.       begin
  204.         ah := $86;
  205.         move(ms,cx,2);
  206.         Intr($15,regs)
  207.       end
  208.   end;  {* Delay *}
  209.  
  210. Function KEYPRESSED : Boolean;
  211.   begin {* KeyPressed *}
  212.     Keypressed := MemW[$0040:$001C] <> MemW[$0040:$001A]
  213.   end;  {* KeyPressed *}
  214.  
  215.  
  216. Function READKEY : char;
  217.   var key : char;
  218.  
  219.   begin {* fReadKey *}
  220.     setfunction := false;
  221.     with regs do
  222.       begin
  223.         repeat                   { wait until keypressed }
  224.           begin
  225.             ah := $01;           { check to see if keyboard buffer is empty }
  226.             Intr($16,regs)
  227.           end
  228.         until flags and fzero = 0;
  229.         ah := $00;               { get next keycode from keyboard buffer }
  230.         Intr($16,regs);
  231.         move(al,key,1);
  232.         if key = null then       { if local keyboard has pressed a function }
  233.           begin                  { key, replace the #0 value with the scan  }
  234.             setfunction := true; { code of the key pressed. }
  235.             move(ah,key,1)
  236.           end;
  237.         ReadKey := key
  238.       end
  239.   end;  {* fReadKey *}
  240.  
  241. Function WHEREX : byte;
  242.   begin {* fWhereX *}
  243.     with regs do
  244.       begin
  245.         ah := $03;
  246.         bh := $00;
  247.         Intr($10,regs);
  248.         WhereX := dl + 2 - baseX
  249.       end
  250.   end;  {* fWhereX *}
  251.  
  252. Function WHEREY : byte;
  253.   begin {* fWhereY *}
  254.     with regs do
  255.       begin
  256.         ah := $03;
  257.         bh := $00;
  258.         Intr($10,regs);
  259.         WhereY := dh + 2 - baseY
  260.       end
  261.   end;  {* f